HPAVC/HPAVC CD-ROM.iso/TP-TSR.ARJ/CMDQ.PAS

Pascal/Delphi Source File | 1989-02-11 | 27KB | 585 lines

{═══════════════════════════════ CMDQ.PAS ════════════════════════════════}
{ ─────────  Turbo 4.0/5.0 stay-resident demonstration program  ───────── }
{                 Copyright (c) 1989  Richard W. Prescott                 }
{ This program provides basic line editing and recall capability at the   }
{ DOS command line and within any program that requests keyboard input    }
{ through interrupt $21 function $0A (Buffered Input).                    }
{                                                                         }
{ The Unit DOS21_0A contains the assembly code for the basic interrupt    }
{ routine, which is installed automatically by the "Uses DOS21_0A"        }
{ clause.  This routine traps only function $0A (Buffered Input),         }
{ chaining to the original interrupt $21 vector for all other function    }
{ requests.  The assembly code issues a FAR Call via the Pointer variable }
{ PascalCode which is initialized in the MAIN block (below) to point to   }
{ the procedure ServiceProc.  ServiceProc repeatedly polls the keyboard   }
{ and calls the appropriate Proc/Function to provide the line edit and    }
{ recall facilities.                                                      }
{                                                                         }
{ The Unit DOS21_0A provides the Procedures IChain for chaining to the    }
{ original interrupt routine, and IReturn for returning directly to the   }
{ calling program.  These may be called from any point within the Pascal  }
{ code.  The user registers at interrupt entry are accessible through the }
{ record variable User^ (User^.Ax, User^.Flags, etc).  They should be     }
{ modified as necessary to simulate a successful interrupt request before }
{ calling IReturn, as illustrated in the procedure ReturnCommand.         }
{                                                                         }
{ The Unit CONSOLE provides routines for changing the cursor shape, as    }
{ well as substitutes for ReadKey, WhereX/Y, and WRITE.  (The CRT Unit    }
{ installs a considerable amount of initialization code, which is         }
{ undesirable in a resident program; the CONSOLE Unit installs no         }
{ initialization code).  The substitutes for WRITE require less code and  }
{ do not respond to Ctrl-C and Ctrl-Break.                                }
{═══════════════════════════════ CMDQ.PAS ════════════════════════════════}

{$M $400,0,0} {- INCREASE STACK during program development! -}
{$S-}         {- REMOVE during program development! -}

{
   ┌─────────────────────────────────────────────────────────────────┐
   │ The default configuration creates a true resident program.      │
   │ To create a version which runs a COMMAND.COM Shell, and can be  │
   │ removed with the DOS Command "Exit", $Define the conditional    │
   │ symbol SHELL or compile using  "TPC cmdq/dshell".  This is      │
   │ useful primarily during program development.                    │
   └─────────────────────────────────────────────────────────────────┘
}

Uses DOS,CONSOLE,DOS21_0A;
CONST
  DefaultMode = TRUE; {Default to Insert}
CONST
{- Standard SCAN Code Constants -}

   F1 = $3B;   F2 = $3C;   F3 = $3D;   F4 = $3E;   F5 = $3F;
   F6 = $40;   F7 = $41;   F8 = $42;   F9 = $43;   F0 = $44;

   HomeKey       = $47;    CtrlHome      = $77;
   UpArrow       = $48;
   PgUp          = $49;    CtrlPgUp      = $84;
   LeftArrow     = $4B;    CtrlLeftArrow = $73;
   RtArrow       = $4D;    CtrlRtArrow   = $74;
   EndKey        = $4F;    CtrlEnd       = $75;
   DownArrow     = $50;
   PgDn          = $51;    CtrlPgDn      = $76;
   InsertKey     = $52;    DeleteKey     = $53;

{- Standard Character Constants -}

   CtrlBkSl {^\} = #$1C;
   BackSpace     = #$08;   CtrlBsp       = #$7F;
   Enter         = #$0D;   CtrlEnter     = #$0A;
   Escape        = #$1B;   Tab           = #$09;
   Null          = #0;


TYPE
  CmdType = STRING[255];
CONST
  Dormant: BOOLEAN = FALSE;
VAR
  CurrentLine: CmdType;
  CurrentLineLen: BYTE Absolute CurrentLine;
  MaxChars: BYTE; {- Maximum Space for Characters in user buffer -}
  LinePos,SavePos: BYTE;
  InsertMode: BOOLEAN;

  CmdQ: ARRAY[0..$FF] OF BYTE;       {- Command Queue -}
  QTail,Qptr,Tptr: ^CmdType;
  QTailLen: ^BYTE Absolute QTail;
  QptrLen:  ^BYTE Absolute QPtr;
  TptrLen:  ^BYTE Absolute TPtr;
  QTailW: WORD Absolute QTail;
  QptrW:  WORD Absolute QPtr;
  TptrW:  WORD Absolute TPtr;

  MarkX,MarkY: BYTE;  Mark: WORD Absolute MarkX;
  Ch: CHAR;    Scan:Byte;    Key: WORD Absolute Ch;



{════════════════════════════════ ReadKey ════════════════════════════════}
{ Emulate CRT Unit ReadKey without CRT Unit overhead.  Ignore Ctrl-C and  }
{ Ctrl-Break.  Uses DosReadKey OR BiosReadKey from CONSOLE Unit, where    }
{ DosReadKey recognizes ANSI macros and BiosReadKey does not.             }
{════════════════════════════════ ReadKey ════════════════════════════════}
FUNCTION ReadKey: CHAR; BEGIN
  ReadKey := DosReadKey;  {- Use BiosReadKey to ignore ANSI Macros -}
END; {FUNCTION ReadKey}


{══════════════════════════════ ShowCursor ═══════════════════════════════}
{ Reset cursor shape based on state of InsertMode flag.                   }
{══════════════════════════════ ShowCursor ═══════════════════════════════}
PROCEDURE ShowCursor; BEGIN
  IF InsertMode THEN WideCursor ELSE ThinCursor;
END; {PROCEDURE ShowCursor}


{══════════════════════════════ CursorLeft ═══════════════════════════════}
{ Move cursor left (or reverse line wrap) and update GLOBAL VAR LinePos.  }
{ Cursor is moved by sending a BackSpace (#8), which allows for reverse   }
{ line wrap within windows defined under certain BIOS enhancements (e.g.  }
{ FANSI-CONSOLE).  If x position does not change, implement reverse line  }
{ wrap by decrementing y position and setting x position to the maximum   }
{ screen column as determined from the BIOS.                              }
{══════════════════════════════ CursorLeft ═══════════════════════════════}
PROCEDURE CursorLeft; BEGIN
  IF LinePos>1 THEN BEGIN

    Mark := ReadCursor;

    WriteChar(#8); Dec(LinePos);

    IF WhereX = MarkX THEN BEGIN
      Dec(MarkY);  MarkX := MaxColumn;  SetCursor(Mark);
    END; {IF WhereX = MarkX THEN }

  END; {IF LinePos>1 THEN }
END; {PROCEDURE CursorLeft}


{═══════════════════════════════ WordLeft ════════════════════════════════}
{ Move cursor to preceding "word start" and update GLOBAL VAR LinePos.    }
{ A "word start" is a non-space preceded by a space (or the line start).  }
{═══════════════════════════════ WordLeft ════════════════════════════════}
PROCEDURE WordLeft; BEGIN
  IF LinePos > 1
  THEN REPEAT CursorLeft
       UNTIL (LinePos = 1)
          OR ((CurrentLine[LinePos]<>' ') AND (CurrentLine[LinePos-1]=' '));
END; {PROCEDURE WordLeft}


{══════════════════════════════ CursorRight ══════════════════════════════}
{ Move cursor right (or wrap to next line) and update GLOBAL VAR LinePos. }
{ Cursor is moved by writing the character at the current LinePos to the  }
{ console, providing automatic line wrap and scrolling as required.       }
{══════════════════════════════ CursorRight ══════════════════════════════}
PROCEDURE CursorRight; BEGIN
  IF LinePos <= CurrentLineLen THEN BEGIN
    WriteChar(CurrentLine[LinePos]); Inc(LinePos);
  END; {IF LinePos>1 THEN }
END; {PROCEDURE CursorRight}


{═══════════════════════════════ WordRight ═══════════════════════════════}
{ Move cursor to following "word start" and update GLOBAL VAR LinePos.    }
{ A "word start" is a non-space preceded by a space (or the line end).    }
{═══════════════════════════════ WordRight ═══════════════════════════════}
PROCEDURE WordRight; BEGIN
  IF LinePos <= CurrentLineLen
  THEN REPEAT CursorRight
       UNTIL (LinePos > CurrentLineLen)
          OR ((CurrentLine[LinePos]<>' ') AND (CurrentLine[LinePos-1]=' '));
END; {PROCEDURE WordRight}


{═══════════════════════════════ CursorHome ══════════════════════════════}
{ Move cursor to the beginning of the line and update GLOBAL VAR LinePos. }
{═══════════════════════════════ CursorHome ══════════════════════════════}
PROCEDURE CursorHome; BEGIN
  WHILE LinePos>1 DO CursorLeft;
END; {PROCEDURE CursorHome}


{═══════════════════════════════ CursorEnd ═══════════════════════════════}
{ Move cursor to the end of the line and update GLOBAL VAR LinePos.       }
{═══════════════════════════════ CursorEnd ═══════════════════════════════}
PROCEDURE CursorEnd; BEGIN
  WHILE LinePos <= CurrentLineLen DO CursorRight;
END; {PROCEDURE CursorEnd}


{═══════════════════════════════ ToggleMode ══════════════════════════════}
{ Toggle cursor size and update GLOBAL Flag InsertMode.                   }
{═══════════════════════════════ ToggleMode ══════════════════════════════}
PROCEDURE ToggleMode; BEGIN
  InsertMode := NOT InsertMode;
  ShowCursor;
END; {PROCEDURE ToggleMode}


{═══════════════════════════════ InsertChar ══════════════════════════════}
{ Insert character at cursor position (moving existing characters and     }
{ cursor one position right) and update GLOBAL VARs CurrentLine and       }
{ LinePos.  Uses SetCursor to restore cursor after screen update.  Note   }
{ however that the last Char written by WriteSubStr may cause the screen  }
{ to scroll, making MarkY invalid.  If WhereY (after update) = MarkY      }
{ (before update) check for scroll by sending a BackSpace; if the cursor  }
{ does not move, a scroll has occurred (decrement MarkY to correct).  If  }
{ it does move, set MarkY = WhereY in case the screen DID scroll but the  }
{ BackSpace caused a reverse line wrap (Supports FANSI-CONSOLE Windows)   }
{═══════════════════════════════ InsertChar ══════════════════════════════}
PROCEDURE InsertChar(Ch1: CHAR); VAR Mark2: WORD; BEGIN
  IF CurrentLineLen < MaxChars-1 THEN BEGIN
    Insert(ch1,CurrentLine,LinePos); CursorRight; { Display Ch/move right }
    Mark := ReadCursor;
    WriteSubStr(CurrentLine,LinePos,1+CurrentLineLen-LinePos);
    IF (LinePos <= CurrentLineLen) AND (WhereY = MarkY) THEN BEGIN
      Mark2 := ReadCursor; WriteChar(#8);        { Send BackSpace }
      IF Mark2 = ReadCursor THEN Dec(MarkY)      { Scrolled: Adjust MarkY }
      ELSE MarkY := WhereY;          { No Scroll or Scroll & reverse wrap }
    END; {IF WhereY = MarkY THEN }
    SetCursor(Mark);
  END; {IF CurrentLineLen < MaxChars-1}
END; {PROCEDURE InsertChar}


{═══════════════════════════════ OverWrite ═══════════════════════════════}
{ Replace character at current cursor position and move right.            }
{ Updates GLOBAL VARs CurrentLine and LinePos.                            }
{═══════════════════════════════ OverWrite ═══════════════════════════════}
PROCEDURE OverWrite(ch1: CHAR); BEGIN
  IF LinePos < MaxChars THEN BEGIN
    IF LinePos > CurrentLineLen THEN Inc(CurrentLineLen);
    WriteChar(Ch1);  CurrentLine[LinePos] := Ch1;  Inc(LinePos);
  END; {IF LinePos < MaxChars}
END; {PROCEDURE OverWrite}


{═══════════════════════════════ DeleteChar ══════════════════════════════}
{ Delete character at cursor position (moving trailing characters one     }
{ one position left) and update GLOBAL VAR CurrentLine.  Cursor position  }
{ is not changed.                                                         }
{═══════════════════════════════ DeleteChar ══════════════════════════════}
PROCEDURE DeleteChar; BEGIN
  IF LinePos <= CurrentLineLen THEN BEGIN
    Mark := ReadCursor; Delete(CurrentLine,LinePos,1);
    WriteSubStr(CurrentLine,LinePos,1+CurrentLineLen-LinePos);
    WriteChar(' '); SetCursor(Mark);
  END; {IF LinePos <= CurrentLineLen THEN }
END; {PROCEDURE DeleteChar}


{═══════════════════════════════ DeleteLeft ══════════════════════════════}
{ Delete character to left of cursor (moving existing characters and      }
{ cursor one position left) and update GLOBAL VARs CurrentLine and        }
{ LinePos.                                                                }
{═══════════════════════════════ DeleteLeft ══════════════════════════════}
PROCEDURE DeleteLeft; BEGIN
  IF LinePos>1 THEN BEGIN
    CursorLeft; DeleteChar;
  END; {IF LinePos>1 THEN }
END; {PROCEDURE DeleteLeft}


{═══════════════════════════════ DisplayNew ══════════════════════════════}
{ Replace CurrentLine with new command (Cmd), and set LinePos to end of   }
{ line.  Erase trailing characters of old line as indicated by OldLen.    }
{ Used by EraseLine, DeleteHome, DeleteEnd, PrevCommand, NextCommand,     }
{ and ClearCommand.                                                       }
{═══════════════════════════════ DisplayNew ══════════════════════════════}
PROCEDURE DisplayNew(VAR Cmd: CmdType; OldLen: BYTE);
VAR n:BYTE;  CmdLen: BYTE Absolute Cmd;  BEGIN
  CursorHome;
  WriteSubStr(Cmd,1,CmdLen);
  IF OldLen > CmdLen THEN BEGIN
    Mark := ReadCursor;
    FOR n := CmdLen TO OldLen-1 DO WriteChar(' ');
    SetCursor(Mark);
  END; {IF OldLen > CmdLen THEN }
  CurrentLine := Cmd;  LinePos := CurrentLineLen+1;
END; {PROCEDURE DisplayNew}


{═══════════════════════════════ EraseLine ═══════════════════════════════}
{ Erase current display line and update GLOBAL VAR CurrentLine.           }
{═══════════════════════════════ EraseLine ═══════════════════════════════}
PROCEDURE EraseLine; BEGIN
  SavePos := CurrentLineLen;
  CurrentLineLen := 0;
  DisplayNew(CurrentLine,SavePos);
END; {PROCEDURE EraseLine; }


{═══════════════════════════════ DeleteHome ══════════════════════════════}
{ Delete characters left of cursor and update GLOBAL VAR CurrentLine.     }
{ Cursor is placed at the beginning of the new line.                      }
{═══════════════════════════════ DeleteHome ══════════════════════════════}
PROCEDURE DeleteHome; BEGIN
  IF LinePos>1 THEN BEGIN
    SavePos := CurrentLineLen;
    Delete(CurrentLine,1,LinePos-1);
    DisplayNew(CurrentLine,SavePos);
    CursorHome;
  END; {IF LinePos>1 THEN }
END; {PROCEDURE DeleteHome}


{═══════════════════════════════ DeleteEnd ═══════════════════════════════}
{ Delete characters from cursor to end of line and update GLOBAL VAR      }
{ CurrentLine.  Cursor is left at the end of the line.                    }
{═══════════════════════════════ DeleteEnd ═══════════════════════════════}
PROCEDURE DeleteEnd; BEGIN
  IF LinePos <= CurrentLineLen THEN BEGIN
    SavePos := CurrentLineLen;
    CurrentLineLen := LinePos-1;
    DisplayNew(CurrentLine,SavePos);
  END; {IF LinePos <= CurrentLineLen THEN }
END; {PROCEDURE DeleteEnd}


   {══════════════════════════════════════════════════════════════════}
   { The following five proceduress manipulate the command queue.     }
   { Commands are stored with a leading AND trailing length byte as   }
   { illustrated below:                                               }
   {       [L0]Cmd0[L0] [L1]Cmd1[L1] [L2]Cmd2[L2] [L3][L3]            }
   {        ^Ofs(CmdQ)   ^QPtr                     ^QTail             }
   { QPtr points to the currently displayed command, viewed as a      }
   { String.  QPtrLen points to the same location but refers to the   }
   { length byte only.  It is used to determine the start of the next }
   { command (Length+2 bytes forward).  QPtrW refers to the offset    }
   { portion of the pointer QPtr/QPtrLen.  It is adjusted directly to }
   { change the command referenced by QPtr.  To move backward in the  }
   { queue, QPtrW is decremented so that QPtrLen refers to the        }
   { trailing length byte of the preceding command.  The start of the }
   { command is then Length+1 bytes backward.                         }
   { The oldest command is always at offset 0 within CmdQ, while      }
   { QTail points to the next available location to store a command.  }
   { If there is not sufficient space at QTail to store a new command }
   { the oldest command is discarded and the remaining ones shifted   }
   { left so that the oldest remaining command is again at Ofs(CmdQ). }
   {══════════════════════════════════════════════════════════════════}


{══════════════════════════════ NextCommand ══════════════════════════════}
{ Advance QPtr to next command in queue and display it.  If pointer       }
{ reaches QTail, cycle back to start of CmdQ (oldest command).            }
{══════════════════════════════ NextCommand ══════════════════════════════}
PROCEDURE NextCommand; VAR n:BYTE; BEGIN
  IF QTail = @CmdQ THEN Exit;
  IF QPtr = QTail THEN QPtr := @CmdQ
  ELSE Inc(QPtrW, QPtrLen^ + 2);
  IF QPtr = QTail THEN QPtr := @CmdQ;
  DisplayNew(QPtr^,CurrentLineLen);
END; {PROCEDURE NextCommand}


{══════════════════════════════ PrevCommand ══════════════════════════════}
{ If display is blank, display current command at QPtr.  Otherwise move   }
{ QPtr back to previous command in queue and display it.  If pointer was  }
{ at start of CmdQ (oldest command), cycle to QTail before moving back.   }
{══════════════════════════════ PrevCommand ══════════════════════════════}
PROCEDURE PrevCommand; BEGIN
  IF QTail = @CmdQ THEN Exit;

  IF (QPtr = QTail) OR (CurrentLineLen<>0) THEN BEGIN
    IF Qptr = @CmdQ THEN QPtr := QTail;
    Dec(QptrW); {Now Pointing to length of Prev Command}
    Dec(QptrW, QPtrLen^ + 1);
  END; {IF (QPtr = QTail) OR (CurrentLineLen<>0) THEN }

  DisplayNew(QPtr^,CurrentLineLen);

END; {PROCEDURE PrevCommand}


{═════════════════════════════ ClearCommand ══════════════════════════════}
{ Remove currently displayed command from command queue.  Shift remaining }
{ commands back to fill the gap, and display the new command at QPtr (the }
{ command following the one removed).                                     }
{═════════════════════════════ ClearCommand ══════════════════════════════}
PROCEDURE ClearCommand; BEGIN
  IF CurrentLine <> QPtr^ THEN BEGIN EraseLine; Exit; END;
  IF (QTail = @CmdQ) OR (QPtr = QTail) THEN Exit;
  Tptr := Qptr;
  Inc(TPtrW, QPtrLen^ + 2);

  Move(TPtr^,QPtr^,Ofs(CmdQ)+SizeOf(CmdQ)-TPtrW);

  Dec(QTailW,TPtrW-QPtrW);

  MemW[Dseg:QTailW]:=0;
  IF QPtr = QTail THEN QPtr := @CmdQ;
  DisplayNew(QPtr^,CurrentLineLen);
END; {PROCEDURE ClearCommand}


{═══════════════════════════════ ClearQueue ══════════════════════════════}
{ Remove all commands from command queue and display a blank line.        }
{═══════════════════════════════ ClearQueue ══════════════════════════════}
PROCEDURE ClearQueue; BEGIN
  EraseLine;
  Qtail:=@CmdQ; QPtr:=QTail; MemW[Dseg:Ofs(CmdQ)]:=0;
END; {PROCEDURE ClearQueue}


{══════════════════════════════ QueueCommand ═════════════════════════════}
{ Append currently displayed command to command queue.  If sufficient     }
{ space is not available at QTail, discard oldest command(s) and move     }
{ remaining commands back until oldest remaining command is at Ofs(CmdQ). }
{══════════════════════════════ QueueCommand ═════════════════════════════}
PROCEDURE QueueCommand; BEGIN
  TPtr := @CmdQ;
  WHILE CurrentLineLen+2+QTailW-TPtrW > SizeOf(CmdQ)
  DO Inc(TPtrW, TPtrLen^ + 2);
  IF   TPtrW <> Ofs(CmdQ)
  THEN Move(TPtr^,CmdQ,Ofs(CmdQ)+SizeOf(CmdQ)-TPtrW);
  Dec(QTailW,TPtrW-Ofs(CmdQ));

  QTail^ := CurrentLine;            {- Add command string -}
  Inc(QTailW,CurrentLineLen+1);
  QTailLen^ := CurrentLineLen;      {- Add trailing length byte -}
  Inc(QTailW);                      {- Set new QTail -}
  QPtr := QTail;                    {- Set Qptr to new QTail -}
END; {PROCEDURE QueueCommand}


{═════════════════════════════ ReturnCommand ═════════════════════════════}
{ Execute return from interrupt.  Place currently displayed command       }
{ STRING (including Length byte) at offset 1 within callers buffer at     }
{ Ds:Dx, and add trailing Carriage Return (#13, not counted in length).   }
{ This emulates the documented action of Interrupt $21 function $0A:      }
{     Input Buffer:   [BufferSize][Length][Line Returned][#13]            }
{    Caller's Ds:Dx    ^+0         ^+1     ^+2            ^+Length+2      }
{ The Buffer Size at Ds:Dx is supplied by the caller.  It is read into    }
{ MaxChars (below) and used by InsertChar and OverWrite to limit the      }
{ maximum allowable size of CommandLine.                                  }
{═════════════════════════════ ReturnCommand ═════════════════════════════}
PROCEDURE ReturnCommand; BEGIN
  CurrentLine[CurrentLineLen+1] := #13;
  Move(CurrentLine,Mem[User^.Ds:User^.Dx +1],CurrentLineLen+2);
  CursorEnd;             {- for wrapped lines -}
  ShowCursor;            {- during command execution -}
  Dos21_0A.IReturn;
END; {PROCEDURE ReturnCommand}


{══════════════════════════════ QueueReturn ══════════════════════════════}
{ Return Command, adding it to the command queue if new or modified.      }
{ Short commands are not added to the queue.                              }
{══════════════════════════════ QueueReturn ══════════════════════════════}
PROCEDURE QueueReturn; BEGIN
  IF (CurrentLineLen > 2)
  AND (CurrentLine <> QPtr^)
  THEN QueueCommand;
  ReturnCommand;
END; {PROCEDURE QueueReturn}


{══════════════════════════════ MacroReturn ══════════════════════════════}
{ Return a predefined command if one is defined for the Scan code of the  }
{ key pressed.  Otherwise exit with no action.  Macro commands are not    }
{ added to the queue.  This feature may be removed or expanded as desired }
{══════════════════════════════ MacroReturn ══════════════════════════════}
PROCEDURE MacroReturn; BEGIN
  SavePos := CurrentLineLen;
  CASE Scan OF
    F1: CurrentLine := 'exit';
    F5: CurrentLine := 'dir c:';
   else Exit;
  END; {CASE Scan}
  DisplayNew(CurrentLine,SavePos);
  ReturnCommand;  {- Return Command without adding to queue -}
END; {PROCEDURE MacroReturn;


{══════════════════════════════ DisplayPath ══════════════════════════════}
{ Display current directory if caller is COMMAND.COM and default drive    }
{ is C or higher.                                                         }
{══════════════════════════════ DisplayPath ══════════════════════════════}
PROCEDURE DisplayPath; VAR Directory: STRING[67];  BEGIN
  IF (DefaultDrive >= 'C') AND (User^.Ds = CommandSig)
   AND (WhereX = 3) THEN BEGIN
    GetDir(0,Directory);
    WriteChar(#8);    WriteChar(#8);
    WriteSubStr(Directory,1,Length(Directory));
    WriteChar('>');
  END; {IF DefaultDrive >= 'C' THEN }
END; {PROCEDURE DisplayPath; }


{══════════════════════════════ ServiceProc ══════════════════════════════}
{ This is the Pascal code for the interrupt service routine, called from  }
{ DOS21_0A.IHook.  If Dormant, checks FIRST keystroke of each line        }
{ requested for the wakeup combination Ctrl-\.  If active, initialize     }
{ CurrentLine and cursor shape, read Caller's buffer size into MaxChars,  }
{ and display current directory path (except floppy drives).  Then poll   }
{ the keyboard and execute edit requests until carriage return or macro.  }
{ If Ctrl-\ is pressed while active, set Dormant flag and chain to the    }
{ original interrupt service routine.                                     }
{══════════════════════════════ ServiceProc ══════════════════════════════}
{$F+} PROCEDURE ServiceProc; {$F-}               {- Force FAR Return -}
{- The Pascal code for the Interrupt Service must be a FAR Procedure -}
BEGIN

  IF Dormant THEN BEGIN
    Key := LookAhead; {- Inspect Key but leave in buffer -}
    IF Ch = CtrlBkSl
    THEN BEGIN Dormant := FALSE; Ch := ReadKey; END
    ELSE Dos21_0A.IChain;
  END; {IF Dormant THEN }

  LinePos := 1;  CurrentLineLen := 0;
  InsertMode := DefaultMode;  ShowCursor;  {- set default -}
  MaxChars := Mem[User^.Ds:User^.Dx];
  DisplayPath;

REPEAT
   {- Display cursor during wait for keystroke -}
  ShowCursor;       Ch := ReadKey;      HideCursor;
  CASE Ch OF
    CtrlBkSl:   BEGIN Dormant := TRUE; EraseLine;
                      ShowCursor;      Dos21_0A.IChain;
                END;
    Enter:      QueueReturn;
    Escape:     EraseLine;
    BackSpace:  DeleteLeft;

    #32..#255:  {- Printable Character -}
                IF InsertMode THEN InsertChar(ch) ELSE OverWrite(ch);

    Null: BEGIN {- Extended Key -}
      ShowCursor;       Scan := Byte(ReadKey);      HideCursor;
      CASE Scan OF
        LeftArrow:      CursorLeft;          RtArrow:        CursorRight;
        CtrlLeftArrow:  WordLeft;            CtrlRtArrow:    WordRight;
        HomeKey:        CursorHome;          EndKey:         CursorEnd;
        CtrlHome:       DeleteHome;          CtrlEnd:        DeleteEnd;
        DeleteKey:      DeleteChar;          InsertKey:      ToggleMode;
        UpArrow:        PrevCommand;         DownArrow:      NextCommand;
        CtrlPgDn:       ClearCommand;        CtrlPgUp:       ClearQueue;
        else            MacroReturn;
      END; {CASE Scan }
    END; {Null: }
  END; {CASE Ch}
UNTIL FALSE;
END; {PROCEDURE ServiceProc}


{═════════════════════════════════ Shell ═════════════════════════════════}
{ Set Sp for Exec Call to avoid our interrupt service stack, then Exec    }
{ COMMAND.COM, looking first on Drive C and then on Drive A.  One could   }
{ also scan the environment block to find the current COMSPEC (even       }
{ though the memory block has been released), but the present method is   }
{ considerably simpler.  On return from Exec, restore original interrupt. }
{═════════════════════════════════ Shell ═════════════════════════════════}
{$IFDEF Shell}    {- Avoid unneeded data ErrMsg IFNDEF Shell -}
PROCEDURE Shell;
  CONST ErrMsg: STRING[25] = 'A:\COMMAND.COM Not Found'#10;
BEGIN
{- Set Sp low to insure that "resident" stack doesn't overlay Exec Return -}
  SetSpLow;
  Exec('C:\Command.com','');
  IF DosError <> 0 THEN Exec('A:\Command.com','');
  IF DosError <> 0 THEN WriteSubStr(ErrMsg,1,Length(ErrMsg));
  Dos21_0A.Irestore;
{- NOTE that Sp is restored by the standard PROCEDURE exit code -}
END; {PROCEDURE Shell; }
{$ENDIF}


{══════════════════════════════════ MAIN ═════════════════════════════════}
{ Initialize Command Queue and set PascalCode Pointer to @ServiceProc.    }
{ Release unneeded environment block, then Shell or go resident.          }
{══════════════════════════════════ MAIN ═════════════════════════════════}
BEGIN {- MAIN PROGRAM SETUP -}

  Qtail:=@CmdQ; QPtr:=QTail; MemW[Dseg:Ofs(CmdQ)]:=0;
  Dos21_0A.PascalCode := @ServiceProc;
  FreeEnvironmentBlock;

  {$IFDEF Shell}   Shell;   {$ELSE}   Keep(0);   {$ENDIF}

END.